home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / embedxpm < prev    next >
Encoding:
Text File  |  2000-12-20  |  2.3 KB  |  114 lines
  1. #!/usr/bin/perl
  2.  
  3. =cut
  4.  
  5. =head1 NAME
  6.  
  7. embedxpm - embed xpm pictures into perl source
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  embedxpm picture.xpm perl_source picture_name
  12.  
  13. =head1 DESCRIPTION
  14.  
  15. embedxpm can be used to embed xpm pictures directly into a perl program. To
  16. do this, your program source has to contain some markers (in the form of
  17. comments) that describe the position where the picture should be inserted.
  18. To only insert the xpm data, use this form:
  19.  
  20.  #%XPM:<name of xpm>%
  21.  <your xpm data goes here>
  22.  #%XPM%<what to attach to the end of the data>
  23.  
  24. Here is an example (taken from the Gimp/PDB program):
  25.  
  26.  C<# create the logo pixmap for the given widget
  27.  sub create_logo($) {
  28.     new Gtk::Pixmap(Gtk::Gdk::Pixmap->create_from_xpm_d(
  29.        $_[0]->window,
  30.        $_[0]->style->black,
  31.        #%XPM:logo%
  32.        'xpm data', 'xpm data...',...
  33.        #%XPM%
  34.     ))
  35.  }>
  36.  
  37. To insert the xpm with the name example.xpm into this source you would have
  38. to use the following commandline:
  39.  
  40.  embedxpm example.xpm source.pl logo
  41.  
  42. I<WARNING:> embedxpm happily overwrites your source, without leaving a
  43. backup-copy around(!). If anything goes wrong (for example when you left out
  44. the end comment) your source may be lost, so better make a backup before. I
  45. am not responsible for your data-loss!
  46.  
  47. =head1 SWITCHES
  48.  
  49. None ;)
  50.  
  51. =head1 AUTHOR
  52.  
  53. Marc Lehmann <pcg@goof.com>
  54.  
  55. =cut
  56.  
  57. use File::Slurp;
  58.  
  59. $VERSION=1.0002;
  60.  
  61. if (@ARGV != 3) {
  62.    die "Usage: $0 xpm_file perl_source picture_name\n";
  63. }
  64.  
  65. $xpm=$ARGV[0];
  66. $file=$ARGV[1];
  67. $id=$ARGV[2];
  68.  
  69. $verbose=1;
  70.  
  71. $columns=80;
  72.  
  73. sub stringify {
  74.    my $s=shift;
  75.    my $r=$s.shift;
  76.    my @r;
  77.    while(@_) {
  78.       if (length($r)+length($_[0])>=$columns) {
  79.          push(@r,$r); $r="$s".shift;
  80.       } else {
  81.          $r.=", ".shift;
  82.       }
  83.    }
  84.    join(",\n",@r,$r);
  85. }
  86.  
  87. open XPM,"<$xpm\0" or die "$xpm: $!\n";
  88. <XPM>=~/^\/\*\s+XPM\s+\*\/$/ or die "$xpm: not a valid xpm file (1)\n";
  89. <XPM>=~/^static\s+char\s+\*\s*(\S+?)(?:_xpm)?\[\]\s+=\s+{$/ or die "$xpm: not a valid xpm file (2)\n";
  90. $xpm_name=$1;
  91.  
  92. print STDERR "found xpm $xpm_name\n" if $verbose;
  93.  
  94. while(<XPM>) {
  95.    y/\t/ /;
  96.    s/'/\\\'/g;
  97.    next if /^\s*\/\*/;
  98.    last unless /\"([^"]*)\"/;
  99.    push(@xpm,"'$1'");
  100. }
  101.  
  102. close XPM;
  103.  
  104. $patch=read_file($file);
  105.  
  106. $patch=~s/^(\s*)(#%XPM:$id%\n).*?(^\s*#%XPM%)(.*?)$/"$1$2".stringify($1,@xpm)."$4\n$3$4"/esmg;
  107.  
  108. write_file("$file~",$patch);
  109. chmod((stat($file))[2],"$file~") or die;
  110. rename "$file~",$file or die;
  111.  
  112.  
  113.  
  114.